home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / db4less3.arc / CUSTOMER.PRG < prev    next >
Text File  |  1990-06-16  |  16KB  |  528 lines
  1. ********************************************************************************
  2. * Program......: CUSTOMER
  3. * Author.......: Bruce Troutman
  4. * Date.........: 12-04-88
  5. * Notice.......: Type information here or greetings to your users.
  6. * dBASE Ver....: See Application menu to use as sign-on banner.
  7. * Generated by.: APGEN version 1.0
  8. * Description..: Customer Names and Addresses Manager
  9.  
  10. * Notes........:
  11. ********************************************************************************
  12.  
  13. SET CONSOLE OFF
  14. IF TYPE("gn_apgen") = "U"  && We were not called from another APGEN program
  15.    CLEAR ALL
  16.    CLEAR WINDOW
  17.    CLOSE ALL
  18.    gn_apgen = 1
  19. ELSE
  20.    gn_apgen = gn_apgen + 1 
  21.    PRIVATE gc_bell, gc_carry, gc_clock, gc_century, gc_confirm, gc_deli,;
  22.            gc_escape, gc_instruc, gc_safety, gc_status, gc_score, gc_talk
  23. ENDIF
  24.  
  25. *-- Window for pause message box (ON ERROR)
  26. DEFINE WINDOW Pause FROM 15,00 TO 19,79 DOUBLE
  27. ON ERROR DO PAUSE WITH [Error occurred on line ]+LTRIM(STR(LINE())) +[ of procedure ]+Program()
  28. ON KEY LABEL F1 DO quickhlp
  29.  
  30. *-- Store initial SETs to variables
  31. gc_bell   =SET("BELL")
  32. gc_carry  =SET("CARRY")
  33. gc_clock  =SET("CLOCK")
  34. gc_century=SET("CENTURY")
  35. gc_confirm=SET("CONFIRM")
  36. gc_deli   =SET("DELIMITERS")
  37. gc_escape =SET("ESCAPE")
  38. gc_instruc=SET("INSTRUCT")
  39. gc_safety =SET("SAFETY")
  40. gc_status =SET("STATUS")
  41. gc_score  =SET("SCOREBOARD")
  42. gc_talk   =SET("TALK")
  43.  
  44. SET CLOCK OFF
  45. SET COLOR TO
  46. CLEAR
  47. SET CONSOLE ON
  48.  
  49. *-- Sets for application
  50. SET BELL ON
  51. SET CARRY OFF
  52. SET CENTURY OFF
  53. SET CONFIRM OFF
  54. SET DELIMITERS TO ""
  55. SET DELIMITER OFF
  56. SET ESCAPE ON
  57. ***SET INSTRUCT OFF ** remove for RunTime
  58. SET SAFETY ON
  59. SET SCOREBOARD OFF
  60. SET STATUS OFF
  61. SET TALK OFF
  62.  
  63. *-- Set global variables
  64. gn_barv  = 0                 && Initialize bar value variable
  65. gn_error = 0                 && Variable to store error() number
  66. gn_send  = 0                 && Return variable from popup
  67. gc_brdr  = "2"               && Border style for menu box - See Procedure
  68. lc_heading = "Customer File Manager" && Menu heading string
  69. ll_color = ISCOLOR()
  70.  
  71. CLEAR
  72. SET ESCAPE ON
  73. SET STATUS ON
  74. *-- Set colors
  75. IF ll_color
  76.    SET COLOR OF NORMAL TO w+/b
  77.    SET COLOR OF MESSAGES TO w+/n
  78.    SET COLOR OF TITLES TO w/b
  79.    SET COLOR OF HIGHLIGHT TO b/w
  80.    SET COLOR OF BOX TO b/w
  81.    SET COLOR OF INFORMATION TO b/w
  82.    SET COLOR OF FIELDS TO b/w
  83. ENDIF
  84.  
  85. USE CUSTOMER INDEX CUSTOMER
  86. SET ORDER TO CUSTNAME
  87.  
  88. *-- Define the main popup menu for Quickapp
  89. SET BORDER TO DOUBLE
  90. DEFINE POPUP quick FROM 7,27
  91. DEFINE BAR 1 OF quick PROMPT " Add Information" MESSAGE "Add records to database CUSTOMER"
  92. DEFINE BAR 2 OF quick PROMPT " Change Information" MESSAGE "Edit records in database CUSTOMER"
  93. DEFINE BAR 3 OF quick PROMPT " Browse Information" MESSAGE "Browse database CUSTOMER"
  94. DEFINE BAR 4 OF quick PROMPT " Discard Marked Records " MESSAGE "Purge deleted records in database CUSTOMER"
  95. DEFINE BAR 5 OF quick PROMPT " Print Report" MESSAGE "Run report form CUSTOMER"
  96. DEFINE BAR 6 OF quick PROMPT " Mailing Labels" MESSAGE "Run label form CUSTOMER"
  97. DEFINE BAR 7 OF quick PROMPT " Reindex Database" MESSAGE "Reindex database CUSTOMER"
  98. DEFINE BAR 8 OF quick PROMPT " Exit From Customer" MESSAGE "Exit program to dBASE"
  99. ON SELECTION POPUP quick DO Action WITH BAR()
  100.  
  101. *-- Define the popup menu for print redirection
  102. DEFINE POPUP prntchk FROM 10,55
  103. DEFINE BAR 1 OF prntchk PROMPT " Send to..." SKIP
  104. DEFINE BAR 2 OF prntchk PROMPT REPLICATE(CHR(196),14) SKIP
  105. DEFINE BAR 3 OF prntchk PROMPT " Screen " MESSAGE "Screen only"
  106. DEFINE BAR 4 OF prntchk PROMPT " Printer " MESSAGE "Printer LPT1:"
  107. DEFINE BAR 5 OF prntchk PROMPT " Label Sample " MESSAGE "Printer LPT1: with Sample label"  SKIP FOR gn_barv <> 6
  108. DEFINE BAR 6 OF prntchk PROMPT " Return" MESSAGE "Return to Main Menu"
  109. ON SELECTION POPUP prntchk DO get_sele
  110.  
  111. *-- Window to cover work surface during edit, append, etc.
  112. DEFINE WINDOW work FROM 0,0 TO 21,79 NONE
  113.  
  114. *-- Window for area below menu heading & for running reports/labels in
  115. DEFINE WINDOW desktop FROM 4,0 TO 21,79 NONE
  116.  
  117. DEFINE WINDOW printemp FROM 10,25 TO 15,56
  118.  
  119. *-- Display heading centered on the screen.
  120. DO menubox WITH lc_heading
  121.  
  122. *-- Show the menu so we don't get a flash if the user hits arrow keys or ESC
  123. SHOW POPUP quick
  124. SAVE SCREEN TO quick
  125. *-- Display Quickapp menu centered on the screen.
  126. DO WHILE gn_barv <> 8 && Prevent user from exiting with arrow keys or ESC
  127.   ACTIVATE POPUP quick
  128. ENDDO
  129.  
  130. * Restore SET environment the best we can
  131. SET BELL &gc_bell.
  132. SET CARRY &gc_carry.
  133. SET CLOCK TO
  134. SET CLOCK &gc_clock.
  135. SET CENTURY &gc_century.
  136. SET CONFIRM &gc_confirm.
  137. SET DELIMITERS &gc_deli.
  138. SET ESCAPE &gc_escape.
  139. *** SET INSTRUCT &gc_instruc. ** Remove for RunTime
  140. SET STATUS &gc_status.
  141. SET SAFETY &gc_safety.
  142. SET SCORE  &gc_score.
  143. SET TALK   &gc_talk.
  144. SET FORMAT TO
  145.  
  146. IF gn_apgen = 1 && We were not called from another APGEN program
  147.    CLEAR WINDOW
  148.    CLEAR POPUP
  149.    CLEAR ALL
  150.    CLOSE ALL
  151. ELSE
  152.    RELEASE WINDOWS work, desktop 
  153.    RELEASE SCREEN quick
  154.    RELEASE POPUP quick
  155.    gn_apgen = gn_apgen - 1 
  156. ENDIF
  157. ON ERROR
  158. ON KEY LABEL F1
  159. RETURN
  160. * EOP: CUSTOMER.PRG
  161.  
  162. ********************************************************************************
  163. * Procedures...: CUSTOMER.Prc
  164. * Author.......: Bruce Troutman
  165. * Date.........: 12-04-88
  166. * Notice.......: Type information here or greetings to your users.
  167. * dBASE Ver....: See Application menu to use as sign-on banner.
  168. * Generated by.: APGEN version 1.0
  169. * Description..: Customer Names and Addresses Manager
  170.  
  171. * Notes........:
  172. ********************************************************************************
  173.  
  174. *-- Here is a sample procedure file to show the power of procdures.
  175. *-- This example - Menubox displays a menu heading box with a centered heading.
  176. PROCEDURE MenuBox
  177. PARAMETER lc_m_name
  178. *-- Parameter lc_m_name - is the title variable for the menu
  179. SET CLOCK OFF
  180. @ 1,0 FILL TO 2,79 COLOR n/n
  181. DO CASE
  182. CASE gc_brdr = "0"
  183.    @ 1,0 CLEAR TO 3,79
  184. CASE gc_brdr = "1"
  185.    @ 1,0 TO 3,79
  186. CASE gc_brdr = "2"
  187.    lc_color = IIF(ISCOLOR(),"b/w", "W+/N")
  188.    @ 1,0 TO 3,79 DOUBLE COLOR &lc_color.
  189. ENDCASE
  190. SET CLOCK TO 2,68
  191. @ 2,1 SAY SUBSTR(CDOW(DATE()),1,3)+'. '+DTOC(DATE())+' '
  192. @ 2,41 - (LEN(lc_m_name)/2) SAY lc_m_name
  193. lc_color = IIF(ISCOLOR(),"w+/b", "W+/N")
  194. @ 2,1 FILL TO 2,78 COLOR &lc_color.
  195. RETURN
  196.  
  197.  
  198. PROCEDURE get_sele
  199. *-- Get the user selection & store BAR into variable
  200. gn_send = BAR()  && Variable for print testing
  201. DEACTIVATE POPUP
  202. RETURN
  203.  
  204. PROCEDURE Action
  205. PARAMETERS bar
  206. *-- Get the user selection & store BAR into variable
  207. gn_barv = bar
  208. SET MESSAGE TO
  209. IF LTRIM( STR( gn_barv)) $ "123"
  210.    *-- Set format file CUSTOMER for edit/append/browse
  211.    SET FORMAT TO CUSTOMER
  212. ENDIF
  213. DO CASE
  214.    CASE gn_barv = 1
  215.       *-- Add information
  216.       SET MESSAGE TO 'Appending records to file CUSTOMER'
  217.       APPEND
  218.    CASE gn_barv = 2
  219.       *-- Change information
  220.       SET MESSAGE TO 'Editing file CUSTOMER'
  221.       EDIT
  222.    CASE gn_barv = 3
  223.       *-- Browse information
  224.       SET MESSAGE TO 'Browsing file CUSTOMER'
  225.       BROWSE FORMAT 
  226.    CASE gn_barv = 4
  227.       *-- Remove information (Pack file customer)
  228.       ACTIVATE WINDOW desktop
  229.       @ 2,0 SAY "Packing database CUSTOMER to REMOVE records marked for deletion..."
  230.       @ 3,0
  231.       SET TALK ON
  232.       PACK
  233.       GO TOP
  234.       ?
  235.       WAIT
  236.       SET TALK OFF
  237.       DEACTIVATE WINDOW desktop
  238.    CASE gn_barv = 5
  239.       *-- Run report form customer
  240.       SET MESSAGE TO 'Pick an option to locate a record or <ESC> for default'
  241.       ACTIVATE WINDOW work
  242.       gn_recno = RECNO()
  243.       DO position
  244.       DEACTIVATE WINDOW work
  245.       lc_toprnt = IIF(gn_recno <> recno(),'REST ','')
  246.       STORE 0 TO gn_send, gn_pkey
  247.       ACTIVATE POPUP prntchk
  248.       IF gn_send = 4
  249.          lc_toprnt = 'TO PRINT'
  250.          ON ERROR DO prntrtry
  251.       ENDIF
  252.       IF .NOT. gn_send = 6
  253.          SET MESSAGE TO 'Printing report CUSTOMER'
  254.          ACTIVATE WINDOW desktop
  255.          SET ESCAPE ON
  256.          REPORT FORM CUSTOMER &lc_toprnt.
  257.          IF gn_pkey <> 27
  258.             WAIT
  259.          ENDIF
  260.          SET ESCAPE ON
  261.          DEACTIVATE WINDOW desktop
  262.       ENDIF
  263.       GOTO gn_recno
  264.       ON ERROR DO PAUSE WITH [Error occurred on line ]+LTRIM(STR(LINE())) +[ of procedure ]+Program()
  265.    CASE gn_barv = 6
  266.       *-- Run label form customer
  267.       SET MESSAGE TO 'Pick an option to locate a record or <ESC> for default'
  268.       ACTIVATE WINDOW work
  269.       gn_recno = RECNO()
  270.       DO position
  271.       DEACTIVATE WINDOW work
  272.       STORE 0 TO gn_send, gn_pkey
  273.       lc_toprnt = IIF(gn_recno <> recno(),'REST ','')
  274.       ACTIVATE POPUP prntchk
  275.       DO CASE 
  276.        CASE gn_send = 4
  277.          lc_toprnt = 'TO PRINT'
  278.        CASE gn_send = 5
  279.          lc_toprnt = 'TO PRINT SAMPLE'
  280.       ENDCASE
  281.       IF .NOT. gn_send = 6
  282.          SET MESSAGE TO 'Printing labels'
  283.          ACTIVATE WINDOW desktop
  284.          SET ESCAPE ON
  285.          ON ERROR DO prntrtry
  286.          LABEL FORM CUSTOMER &lc_toprnt.
  287.          IF gn_pkey <> 27
  288.             WAIT
  289.          ENDIF
  290.          SET ESCAPE ON
  291.          DEACTIVATE WINDOW desktop
  292.       ENDIF
  293.       GOTO gn_recno
  294.       ON ERROR DO PAUSE WITH [Error occurred on line ]+LTRIM(STR(LINE())) +[ of procedure ]+Program()
  295.    CASE gn_barv = 7
  296.       *-- Reindex customer
  297.       ACTIVATE WINDOW desktop
  298.       @ 3,0 SAY "Reindexing database CUSTOMER..."
  299.       @ 4,0
  300.       SET TALK ON
  301.       REINDEX
  302.       GO TOP
  303.       ?
  304.       WAIT
  305.       SET TALK OFF
  306.       DEACTIVATE WINDOW desktop
  307.    CASE gn_barv = 8
  308.       DEACTIVATE POPUP
  309. ENDCASE
  310. SET MESSAGE TO
  311. IF gc_status = "OFF"
  312.    SET STATUS ON
  313. ENDIF
  314. SET FORMAT TO
  315. RESTORE SCREEN FROM quick
  316. RETURN
  317.  
  318. PROCEDURE Pause
  319. PARAMETER lc_msg
  320. *-- Parameters : lc_msg = message line
  321. IF TYPE("lc_message")="U"
  322.    gn_error=ERROR()
  323. ENDIF
  324. lc_msg = lc_msg
  325. lc_option='0'
  326. ACTIVATE WINDOW Pause
  327. IF gn_error > 0
  328.    IF TYPE("lc_message")="U"
  329.       @ 0,1 SAY [An error has occurred !! - Error message: ]+MESSAGE()
  330.    ELSE
  331.       @ 0,1 SAY [Error # ]+lc_message
  332.    ENDIF
  333. ENDIF
  334. @ 1,1 SAY lc_msg
  335. WAIT " Press any key to continue..."
  336. DEACTIVATE WINDOW Pause
  337. RETURN
  338.  
  339.  
  340. PROCEDURE quickhlp
  341. *--  If you want to include help for a quickapp uncomment the lines below and
  342. *--  put your help @ say's into the case statements
  343. *ACTIVATE WINDOW desktop
  344. *CLEAR
  345. DO CASE
  346.   CASE BAR() = 1
  347.   CASE BAR() = 2
  348.   CASE BAR() = 3
  349.   CASE BAR() = 4
  350.   CASE BAR() = 5
  351.   CASE BAR() = 6
  352.   CASE BAR() = 7
  353.   CASE BAR() = 8
  354. ENDCASE
  355. *WAIT
  356. *DEACTIVATE WINDOW desktop
  357. RETURN
  358.  
  359. PROCEDURE Position
  360. IF LEN(DBF()) = 0
  361.    DO Pause WITH "Database not in use. "
  362.    RETURN
  363. ENDIF
  364. SET SPACE ON
  365. SET DELIMITERS OFF
  366. ln_type=0          && sublevel selection
  367. ln_rkey=READKEY()  && test for ESC or Return
  368. ln_rec=RECNO()     && DBF record number
  369. ln_num=0           && for input of a number
  370. ld_date=DATE()     && for input of a date
  371. lc_option='0'      && main option ie. Seek, Goto and Locate
  372. *-- Scope ie. ALL, REST, NEXT <n>
  373. STORE SPACE(10) TO lc_scp
  374. *-- 1 = Character SEEK, 2 = For clause, 3 = While clause
  375. STORE SPACE(40) TO lc_ln1, lc_ln2, lc_ln3
  376. lc_temp=""
  377. @ 0,00 SAY "Index order: "+IIF(""=ORDER(),"Database is in natural order",ORDER())
  378. @ 1,00 SAY "Listed below are the first 16 fields."
  379. lc_temp=REPLICATE(CHR(196),19)
  380. @ 2,0 SAY CHR(218)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp
  381. ln_num=240
  382. DO WHILE ln_num < 560
  383.    lc_temp=FIELD( (ln_num-240)/20 +1)
  384.    @ (ln_num/80),MOD(ln_num,80) SAY CHR(179)+;
  385. lc_temp+SPACE(11-LEN(lc_temp))+;
  386. SUBSTR("= Char  = Date  = Logic = Num   = Float = Memo          ",;
  387. AT(TYPE(lc_temp),"CDLNFMU")*8-7,8)
  388.    ln_num=ln_num+20
  389. ENDDO
  390. ln_num=1
  391.  
  392. DEFINE POPUP Posit1 FROM 8,30
  393. DEFINE BAR 1 OF Posit1 PROMPT " Position by " SKIP
  394. DEFINE BAR 2 OF Posit1 PROMPT REPLICATE(CHR(196),15) SKIP
  395. DEFINE BAR 3 OF Posit1 PROMPT " SEEK Record" MESSAGE "Search on index key" SKIP FOR ""=ORDER()
  396. DEFINE BAR 4 OF Posit1 PROMPT " GOTO Record" MESSAGE "Position to specific record"
  397. DEFINE BAR 5 OF Posit1 PROMPT " LOCATE Record " MESSAGE "Locate record for condition"
  398. DEFINE BAR 6 OF Posit1 PROMPT " Return" MESSAGE "Return without positioning"
  399. ON SELECTION POPUP Posit1 DO get_sele
  400.  
  401. SET CONFIRM ON
  402. DO WHILE lc_option='0'
  403.   ACTIVATE POPUP Posit1
  404.   lc_option = ltrim(str(gn_send))  && for popup
  405.    IF LASTKEY() = 27 .OR. lc_option="6"
  406.       GOTO ln_rec
  407.       EXIT
  408.    ENDIF
  409.    DO CASE
  410.    CASE lc_option='3'
  411.       *-- Seek
  412.       IF LEN(NDX(1))=0 .AND. LEN(MDX(1))=0
  413.          DO Pause WITH "Can't use this option - No index files are open."
  414.          LOOP
  415.       ENDIF
  416.       ln_type=1
  417.       lc_ln1=SPACE(40)
  418.       DEFINE WINDOW Posit2 FROM 8,19 TO 15,62 DOUBLE
  419.       ACTIVATE WINDOW Posit2
  420.       @ 1,1 SAY "Enter the type of expression:" GET ln_type PICT "#" RANGE 1,3
  421.       @ 2,1 SAY "(1=character, 2=numeric and 3=date.)"
  422.       READ
  423.       IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  424.          SET CONFIRM ON
  425.          @ 3,1 SAY "Enter the key expression to search for:"
  426.          IF ln_type=3
  427.             @ 4,1 GET ld_date PICT "@D"
  428.          ELSE
  429.             IF ln_type=2
  430.                @ 4,1 GET ln_num PICT "##########"
  431.             ELSE
  432.                @ 4,1 GET lc_ln1
  433.             ENDIF
  434.          ENDIF
  435.          READ
  436.          SET CONFIRM OFF
  437.          IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  438.             lc_temp=IIF(ln_type=1,"TRIM(lc_ln1)",IIF(ln_type=2,"ln_num","ld_date"))
  439.             SEEK &lc_temp.
  440.          ENDIF
  441.       ENDIF
  442.       RELEASE WINDOWS Posit2
  443.    CASE lc_option='4'
  444.       *-- Goto
  445.       ln_type=1
  446.       DEFINE POPUP Posit2 FROM 8,30
  447.       DEFINE BAR 1 OF Posit2 PROMPT " GOTO:" SKIP 
  448.       DEFINE BAR 2 OF Posit2 PROMPT REPLICATE(CHR(196),10) SKIP 
  449.       DEFINE BAR 3 OF Posit2 PROMPT " TOP" MESSAGE "GOTO Top of File"
  450.       DEFINE BAR 4 OF Posit2 PROMPT " BOTTOM" MESSAGE "GOTO Bottom of File"
  451.       DEFINE BAR 5 OF Posit2 PROMPT " Record # " MESSAGE "GOTO A Specific Record"
  452.       ON SELECTION POPUP Posit2 DO get_sele
  453.       ACTIVATE POPUP posit2
  454.       ln_type = gn_send
  455.       IF LASTKEY() <> 27
  456.          IF ln_type=5
  457.             DEFINE WINDOW Posit2 FROM 8,26 TO 13,50 DOUBLE
  458.             ACTIVATE WINDOW Posit2
  459.             ln_num=0
  460.             @ 3,1 SAY "Max. Record # = "+LTRIM(STR(RECCOUNT()))
  461.             @ 1,1 SAY "Record to GOTO" GET ln_num PICT "######" RANGE 1,RECCOUNT()
  462.             READ
  463.             IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  464.                GOTO ln_num
  465.             ENDIF
  466.             RELEASE WINDOWS Posit2
  467.          ELSE
  468.            lc_temp=IIF(ln_type=3,"TOP","BOTTOM")
  469.            GOTO &lc_temp.
  470.          ENDIF
  471.       ENDIF
  472.    CASE lc_option='5'
  473.       *-- Locate
  474.       DEFINE WINDOW Posit2 FROM 8,16 TO 14,66 DOUBLE
  475.       ACTIVATE WINDOW Posit2
  476.       @ 1,19 SAY "ie. ALL, NEXT <n>, and REST"
  477.       @ 1,01 SAY "Scope:" GET lc_scp
  478.       @ 2,01 SAY "For:  " GET lc_ln2
  479.       @ 3,01 SAY "While:" GET lc_ln3
  480.       READ
  481.       IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  482.          lc_temp=TRIM(lc_scp)
  483.          lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln2)) > 0," FOR "+TRIM(lc_ln2),"")
  484.          lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln3)) > 0," WHILE "+TRIM(lc_ln3),"")
  485.          IF LEN(lc_temp) > 0
  486.             LOCATE &lc_temp.
  487.          ELSE
  488.             DO Pause WITH "All fields were blank."
  489.          ENDIF
  490.       ENDIF
  491.       RELEASE WINDOW Posit2
  492.    ENDCASE
  493.    IF EOF()
  494.       DO Pause WITH "Record not found."
  495.       GOTO ln_rec
  496.    ENDIF
  497.    IF READKEY()=12 .OR. READKEY()= 268 .OR. LASTKEY()=27  && Esc was hit
  498.       lc_option='0'
  499.    ENDIF
  500. ENDDO
  501. SET DELIMITERS &gc_deli.
  502. SET CONFIRM OFF
  503. RETURN
  504.  
  505.  
  506. PROC prntrtry
  507. PRIVATE lc_escape
  508. lc_escape = SET("ESCAPE")
  509. IF .NOT. PRINTSTATUS()
  510.    IF lc_escape = "ON"
  511.        SET ESCAPE OFF
  512.     ENDIF
  513.    gn_pkey = 0
  514.    ACTIVATE WINDOW printemp
  515.    @ 1,0 SAY "Please ready your printer or"
  516.    @ 2,0 SAY "     press ESC to cancel"
  517.    DO WHILE ( .NOT. PRINTSTATUS()) .AND. gn_pkey <> 27
  518.       gn_pkey = INKEY()
  519.    ENDDO
  520.    DEACTIVATE WINDOW printemp
  521.    SET ESCAPE &lc_escape
  522.    IF gn_pkey <> 27
  523.       RETRY
  524.    ENDIF
  525. ENDIF
  526. RETURN
  527. * EOF: CUSTOMER.PRG
  528.